Attribute VB_Name = "modODBCStaples"
'---------------------------------------------------------------------------------------
'Module     : modODBC
'Date       : 05/18/2004
'Updated    : 02/21/2005
'Author     : Chris Elwell
'Purpose    : This is an example of a CIC integration module. This is for demostration
'           purposes only. You must write the code required to get/writeback data from/to
'           your customer's data source.
'
'           This example uses the FSMSClientTest.mdb. A DSN is setup as FSMSClientTest.
'           Regardless of the integration method, CICs must have a module that contains
'           specific sub routines. All of these subs/functions listed below must exist
'           as they are called from the main program.
'           Public Function GetData(ByVal strKey As String) As Boolean - this routine is
'               called when the Order ID field loses focus. This is where you would code to
'               get order data from a customer and populate the screen fields. You can create
'               and call as many support routines as necessary. Also, this routine should
'               return a boolean True if getting the order data was succesful and a boolean
'               False if it was not.
'           Public Sub WriteReply() - this is called after a successful shipment. A typical
'               use would be to write FXRS reply data back to a customer's system, but can be
'               used for anything that you want to have happen after a pckage is shipped.
'           Public Sub WriteError() - this is called after an error is returned from FXRS.
'           Public Sub WriteDelete(ByVal strTracking As String) - this is called after a
'               package is successfully deleted.
'           Public Sub AfterClose() - this is called after FXRS is closed.
'           Public Sub BeforeClose() - this is called just before an FXRS close transaction
'               is sent.
'Updated:   Public Function BeforeShip() - Return TRUE to continue shipment, False to cancel.
'           Public Sub Initialize() - this is called once on program execution.
'           Public Sub BeforeBatch() - this is called before processing a batch file.
'           Public Sub BeforeBatchShip() - this is called before each individual batch transaction.
'New:       Public Sub AfterAddrLookup() - this is called after cboCustID, cboContact, and cboCompany lose focus
'New:       Public Sub AfterDeptLostFocus() - this is called after cboDept or f38 loses focus.
'
' 2005-04-20, JFW, Added AddDSN for integration database.
' 2006-11-07, JFW, Add order to MPS select to preserve package order
' 2007-04-13, JFW, Allow for custom screen display, AfterConnect
'
'---------------------------------------------------------------------------------------


Option Explicit

#If Staples Then

Dim m_CNIn As ADODB.Connection
Dim m_CNOut As ADODB.Connection
Dim m_RS As ADODB.Recordset
Dim m_strLine As String


'2/8/05 - API function declaration to add DSN to system used in AddDSN() function.
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
   hwndParent As Long, ByVal fRequest As Long, ByVal _
   lpszDriver As String, ByVal lpszAttributes As String) As Long

'+
' 2006-09-20, JFW, From Copernicus FXI
' Declare object(s)
Public g_strCustNo As String        'Hold Customer Number
Public g_strPONo As String          'Hold Customer PO Number
Public g_strRefNo As String         'Hold Customer Reference Number
Public g_strCountry As String       'Hold shipto Country
Public g_strZip As String           'Holds zip code
Public g_strEmail As String         'Hold Email address
Public g_strEmail2 As String        'Hold Email address
Public g_blnServiceOrder As Boolean 'Flage for email
'~

   
'---------------------------------------------------------------------------------------
' Procedure : AddDSN
' DateTime  : 2/8/2005
' Purpose   : Adds the FSMSClient v720.3 DSN
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Private Function AddDSN() As Boolean
    On Error GoTo EH
    
    Dim ret As Long
    Dim Driver As String
    Dim Attributes As String
    
    If GetSystemName = "WINXPC9CA96EA3" Then
        Driver = "Microsoft Access Driver (*.mdb)"
        Attributes = Attributes & "DBQ=C:\Program Files\FedEx\Integration\Projects\Meena\CorporateExpress.mdb" & Chr(0)
        Attributes = Attributes & "DSN=CorporateExpress" & Chr(0)
    Else
        Driver = "Microsoft Access Driver (*.mdb)"
        Attributes = Attributes & "DBQ=" & App.Path & "\FedExData.mdb" & Chr(0)
        Attributes = Attributes & "DSN=FedExData" & Chr(0)
    End If
    Attributes = Attributes & "DESCRIPTION=FSMS Client Corp Express FedEx data" & Chr(0)

    ret = SQLConfigDataSource(0, 4, Driver, Attributes)
   
    If ret <> 1 Then
        AddDSN = False
    Else
        AddDSN = True
    End If

    Exit Function
EH:
    AddDSN = False

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BuildCustomSPLabel()
' DateTime  : 20070620-04
' Purpose   : REQUIRED SUB. Can be used as hook to create custom EPL or ZPL buffer labels
'             for SmartPost.
'---------------------------------------------------------------------------------------
'
Public Function BuildCustomSPLabel(ByVal strLabel As String) As String

    BuildCustomSPLabel = strLabel

End Function
'

Public Function ClearShipScreen() As Boolean

    frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
    
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetData(ByVal strKey As String) As Boolean
    On Local Error GoTo Handler
    Dim strSelect As String
    Dim strUserPwd As String    'DSN user and password separated by ','
    Dim strUser As String       'DSN user name
    Dim strPwd As String        'DSN user password
    Dim strData As String
    Dim i As Long
    
    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" _
    And g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Order Lookup" Then
        GetData = True
        Exit Function
    End If
        
    strSelect = "select * from " & g_clsSettings.Setting("IntegrationTableIn") & " Where "
    strSelect = strSelect & "LicencePlate = '" & strKey & "' "
    
    If Not Connect Then Exit Function   'set conection and recordset

    m_RS.CursorLocation = adUseClient
    m_RS.Open strSelect, m_CNIn, adOpenStatic     'run SELECT

    ' Set m_RS.ActiveConnection = Nothing
    ' m_CNIn.Close

    If m_RS.BOF And m_RS.EOF Then
        'No records found for that order number
        m_RS.Close
        GetData = False
        Exit Function
    End If
    
    'Example use of SetCurrentAccount to programmatically change the current shipping account
'    If Not SetCurrentAccount(m_RS!AcctNum) Then
'        MsgBox "Account not found. Please select account from Location box", vbExclamation, "Error"
'    End If

    Call DeleteIntlCommodities(strKey)

    If m_RS.EOF Then
        strData = "No records"
    Else
        For i = 0 To m_RS.Fields.Count - 1
            strData = strData & vbCrLf & m_RS.Fields(i).name & " " & m_RS.Fields(i).Value
        Next i
    End If
    
    strData = "Record count " & m_RS.RecordCount & vbCrLf & strData
    
    Call GetDataToShip

    ' Example use of the SetMessage sub
    ' Call SetMessage("Destination state is: " & m_RS!State, 16, vbBlack, True)

    GetData = True
Release:
    ' call kill
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetData"
    Call Kill
    Resume Release
    

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShip()

    On Local Error GoTo Handler

    Dim strZipCode As String
    Dim intZipLen As Integer
    Dim lngWeight As Double
    Dim strHarmCode As String
    Dim strMyHarmCode As String
    Dim strCCofMan  As String
    Dim strTaxID As String
    
'    ' Declare variables for procedure
'    Dim i As Long
'    Dim blnADDComm As Boolean
'    Dim strCommCode As String
'    Dim strSQLComm As String
'    Dim strMeter As String
        
    With frmShip
        
        g_strErrorLocation = "Zip"
        g_strZip = Trim(CStr(m_RS!PostalCode & ""))
    
        g_strErrorLocation = "Country"
        g_strCountry = IIf(IsNumeric(Trim(CStr(m_RS!PostalCode & ""))), "US", "CA")
        
        g_strErrorLocation = "AccountSwitch"
        If False Then
        If GetSystemName <> "CAN-00278478" Then
            If g_strCountry = "US" Then
                If Not SetCurrentAccount("224037961") Then
                    MsgBox "Unable to switch to US account 224037961.  Please select account from Location box", vbExclamation, "Error"
                End If
            Else
                If Not SetCurrentAccount("221737920") Then
                    MsgBox "Unable to switch to account 221737920.  Please select account from Location box", vbExclamation, "Error"
                End If
            End If
        End If
        End If
        
        g_strErrorLocation = "?"
        
        .f11.Text = Trim(CStr(m_RS!CompanyName & ""))
        .f12.Text = Trim(CStr(m_RS!CareOf & ""))
        
        .f13.Text = Trim(CStr(m_RS!AddressLine1 & ""))
        .f14.Text = Trim(CStr(m_RS!AddressLine2 & ""))
        .f15.Text = Trim(CStr(m_RS!City & ""))
        .f16.Text = Trim(CStr(m_RS!Province & ""))
        .f17.Text = g_strZip
        .f18.Text = Trim(CStr(m_RS!PhoneNumber & ""))
        .f50.Text = g_strCountry
        
        .f3056.Text = Trim(CStr(m_RS!CustomerPO & ""))
        .f3057.Text = Trim(CStr(m_RS!InvoiceNumber & ""))
        g_str581 = .f3056
        g_str582 = .f3057
        .f25 = Trim(CStr(m_RS!LicencePlate & ""))
        g_strRefNo = .f25
        
        g_strErrorLocation = "Email"
        g_strEmail = Trim(CStr(m_RS!RecipientEmail & ""))
        g_strEmail2 = ""
        If g_strEmail <> "" Or g_strEmail2 <> "" Then
            frmShip.chkEmailAlert.Value = 1
            DoEvents
        End If
        If g_strEmail <> "" Then
            frmEmail.f1202.Text = g_strEmail ' Recipient email
            frmEmail.f1557.Value = 1 ' .SpecialServices.ShipAlert.Recipient.ShipmentNotification = True
            
'            frmEmail.f1202(0).Text = g_strEmail ' Recipient email
'            frmEmail.f1557(0).Value = 1 ' .SpecialServices.ShipAlert.Recipient.ShipmentNotification = True
'            frmEmail.f1202(1).Text = g_strEmail ' Recipient email
'            frmEmail.f1557(1).Value = 1 ' .SpecialServices.ShipAlert.Recipient.ShipmentNotification = True
'            ' .SpecialServices.ShipAlert.Recipient.GroundMemo = "Invoice #:" & g_strRefNo & " / P.O. #:" & g_strPONo
        End If
        If g_strEmail2 <> "" Then
            frmEmail.f1204(1).Text = g_strEmail2 ' .SpecialServices.ShipAlert.Other1.Email = g_strEmail2
            frmEmail.f1206(1).Value = 1 ' .SpecialServices.ShipAlert.Other1.ShipmentNotification = True
            ' .SpecialServices.ShipAlert.Other1.GroundMemo = "Invoice #:" & g_strRefNo & " / P.O. #:" & g_strPONo
        End If
        If g_strEmail <> "" Or g_strEmail2 <> "" Then
            Call frmEmail.Save
            DoEvents
        End If
        
        g_strErrorLocation = "Piece"
        .f116.Text = Trim(CStr(m_RS!PackageCount & ""))
        
        g_strErrorLocation = "?"
        
        .f23.Text = "1"
        If IsNumeric(Trim(CStr(m_RS!PackageType & ""))) Then
            .f1273.Text = Right("00" & Trim(CStr(m_RS!PackageType & "")), 2)
        Else
            .f1273.Text = "01"
        End If
        .f75.Text = "LBS"
        
        g_strErrorLocation = "Service"
        .f1274.Text = "01"
        
        g_strErrorLocation = "TD"
        If g_strCountry <> "CA" Then
            .f1090.Text = "USD"
        Else
            .f1090.Text = "CAD"
        End If
                
        lngWeight = 0
        If IsNumeric(Trim(CStr(m_RS!BoxLength & ""))) _
        And IsNumeric(Trim(CStr(m_RS!BoxHeight & ""))) Then
            .f59 = CLng(Trim(CStr(m_RS!BoxLength & "")))
            .f58 = CLng(Trim(CStr(m_RS!BoxHeight & "")))
            .f57 = CLng(Trim(CStr(m_RS!BoxHeight & "")))

'            .f59(0) = CLng(Trim(CStr(m_RS!BoxLength & "")))
'            .f58(0) = CLng(Trim(CStr(m_RS!BoxHeight & "")))
'            .f57(0) = CLng(Trim(CStr(m_RS!BoxHeight & "")))
        End If
        
        'Alternate Return Address field variables
        g_str1586 = "Y"           'Field 1586 - Print Alt Return Address flag
        g_str1485 = ""            'Field 1485 - Alt Return Contact
        g_str1486 = Trim(CStr(m_RS!FROM_Name & ""))           'Field 1486 - Alt Return Company
        g_str1487 = Trim(CStr(m_RS!FROM_AddressLine1 & ""))           'Field 1487 - Alt Return Addr 1
        g_str1488 = Trim(CStr(m_RS!FROM_AddressLine2 & ""))           'Field 1488 - Alt Return Addr 2
        g_str1489 = Trim(CStr(m_RS!FROM_City & ""))           'Field 1489 - Alt Return City
        g_str1490 = Trim(CStr(m_RS!FROM_Province & ""))           'Field 1490 - Alt Return State
        g_str1491 = Trim(CStr(m_RS!FROM_PostalCode & ""))           'Field 1491 - Alt Return ZIP
        g_str1492 = Trim(CStr(m_RS!FROM_Telephone & ""))           'Field 1492 - Alt Return Phone #
        g_str1585 = "CA"          'Field 1585 - Alt Return Country
        
'
'     CustomerNumber    OrderedBy     OrderReleaseDate
        
        If Trim(CStr(m_RS!DeliveryInstructions & "")) <> "" Then
            frmMsgBox.ShowMessage Trim(CStr(m_RS!DeliveryInstructions & "")), 4000
        End If
        If IsNumeric(Trim(CStr(m_RS!TotalOrderValue & ""))) Then
            .f26 = CLng(Trim(CStr(m_RS!TotalOrderValue & "")))
        End If
        If IsNumeric(m_RS!PackageGroupWeight) Then
            .f1670.Text = Val(m_RS!PackageGroupWeight)
        End If
        If IsNumeric(.f1670.Text) Then
            If CDbl(.f1670.Text) <= 0 Then
                .f1670.Text = 1
            End If
        Else
            .f1670.Text = 1
        End If
        
        .f1670.SetFocus 'Set focus to read scale
    End With

    g_strErrorLocation = "Done"
Release:
    ' call kill
    Exit Sub
Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : GetPickupData()
' DateTime  : 1/30/2006
' Purpose   : REQUIRED SUB. Called from frmAddTags.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetPickupData(ByVal strKey As String) As Boolean


    GetPickupData = True

End Function
'

' 2011-05-05, JFW, For Scapa
Public Function TDAutoCloseEnabled() As Boolean
    TDAutoCloseEnabled = False
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : WriteBatchEditReply()
' DateTime  : 1/17/2006
' Purpose   : REQUIRED SUB. Called after a successful Batch Error Edit transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBatchEditReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteBOLReply()
' DateTime  : 1/11/2006
' Purpose   : REQUIRED SUB. Called after a successful FedEx Freight BOL transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBOLReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteReply()
' DateTime  : 2/14/2005
' Purpose   : REQUIRED SUB. Called after a successful ship transaction.
'             This example shows how to obtain multiple occurrence fields from the
'             FXRS reply and how to obtain multiple occurrence fields included in the
'             input transaction but not returned in the FXRS reply.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReply()
    
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    
    Dim i As Integer
    Dim j As Integer
    
    Dim f1 As String                    'OrderID (in TransID field)
    Dim f35 As String                   'Total surcharges
    Dim f37 As String                   'Net charge
    Dim f60 As String                   'Billed weight
    Dim f116 As String                  'Num pkgs
    Dim strInsert As String             'SQL INSERT
    Dim strMPS As String                'MPS SELECT query
    Dim rsMPS As New ADODB.Recordset    'Used to capture MPS input fields
    
    'Declare string arrays for trk#s and declared values
    Dim str29() As String
    Dim str26() As String
    
    Dim intNumPkgs As Integer

    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" Then
        Exit Sub
    End If

    ' 2006-11-07, JFW, writeback table requires invoice number field.
    If g_str25 = "" Then
        Exit Sub
    End If
    
    g_strErrorLocation = "Connect"
    If Not Connect Then Exit Sub

    If IsNumeric(g_str37) Then
        f37 = CDbl(g_str37) / 100
    Else
        f37 = 0
    End If
    
    g_strErrorLocation = "SQL"
    strSQL = "Update " & g_clsSettings.Setting("IntegrationTableOut") & " set "
    strSQL = strSQL & "Waybill = '" & g_str29 & "', "
    strSQL = strSQL & "FreightCharges = " & f37 & " "
    strSQL = strSQL & "Where LicencePlate = '" & g_str25 & "' "
    
    m_CNOut.Execute strSQL
    
    g_strErrorLocation = "Done"
    
Release:
    ' call kill
    If rsMPS.State = adStateOpen Then rsMPS.Close
    Set rsMPS = Nothing
    Exit Sub

Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.WriteReply"
    Call Kill
    Resume Release
    Resume
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteReturnDelete()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label delete transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnDelete(ByVal strTracking As String)

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnReply()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteError()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an FXRS Error reply transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteError()
    MsgBox "Shipping Error: " & g_str3, vbCritical, "FSMS Error"
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteCancelTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Cancel Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteCancelTagReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteDelete()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             successful FXRS Delete.
'---------------------------------------------------------------------------------------
'
Public Sub WriteDelete(ByVal strTracking As String)
'Called:    frmShip Parsecomplete event on FSMS 123 reply
'Purpose:   update customer table on void
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    Dim lngErr As Long

    If g_clsReg.GetRegistryValue("IntegrationLevel", "Writeback") <> "Writeback" Then
        Exit Sub
    End If

    ' Validate Connection state
    If Not Connect Then Exit Sub

    ' Validate * is compliant with inline error handling
    On Error Resume Next

    g_strErrorLocation = "SQL"
    ' Set SQL statement
    strSQL = "Update FedExData set "
    strSQL = strSQL & "Waybill = '" & "" & "', "
    strSQL = strSQL & "FreightCharges = " & 0 & " "
    strSQL = strSQL & "Where Waybill = '" & strTracking & "' "
    
    m_CNOut.Execute strSQL
    
Release:
   ' call kill
   Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.WriteDelete"
    Call Kill
    Resume Release
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteTagReply()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : Connect()
' DateTime  : 7/5/2004
' Purpose   : Open connection to ODBC test DSN. Instantiate module level recordset.
'---------------------------------------------------------------------------------------
'
Private Function Connect() As Boolean
    On Local Error GoTo Handler
    Dim strDSN As String
    Dim boolSecondTry As Boolean
    
    If m_CNIn Is Nothing Then
        Set m_CNIn = New ADODB.Connection
    End If
    If m_CNOut Is Nothing Then
        Set m_CNOut = New ADODB.Connection
    End If
    Set m_RS = New ADODB.Recordset
    
    If m_CNIn.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" Then
            
            m_CNIn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydatabase.mdb;User Id=admin;Password=;"
            
            '"DSN=CorporateExpress"
            '        Driver = "Microsoft Access Driver (*.mdb)"
        'Attributes = Attributes & "DBQ=C:\Program Files\FedEx\Integration\Projects\Meena\CorporateExpress.mdb" & Chr(0)
        'Attributes = Attributes & "DSN=CorporateExpress" & Chr(0)

        Else
            m_CNIn.Open g_clsSettings.Setting("IntegrationConnectionIn")
        End If
    End If
    
    If m_CNOut.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" Then
            m_CNOut.Open "DSN=CorporateExpress"
        Else
            m_CNOut.Open g_clsSettings.Setting("IntegrationConnectionOut")
        End If
    End If
    
    Connect = True
    
    Exit Function

Handler:
    If Not boolSecondTry Then
        boolSecondTry = True
        If Err.number = -2147467259 Then
            Call AddDSN
            Resume
        End If
    End If
    MsgBox Err.Description, , "modODBC.Connect"
    Call Kill        'kill connection and recordset

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : Kill()
' DateTime  : 7/5/2004
' Purpose   : Close connection and recordset objects and set = to nothing.
'---------------------------------------------------------------------------------------
'
Public Sub Kill()
    On Local Error GoTo Handler
    
    If Not m_RS Is Nothing Then
        If m_RS.State = adStateOpen Then m_RS.Close
    End If
    If Not m_CNIn Is Nothing Then
        If m_CNIn.State = adStateOpen Then m_CNIn.Close
    End If
    
    Set m_CNIn = Nothing      'kill connection
    Set m_RS = Nothing      'kill recordset
    
    If Not m_CNOut Is Nothing Then
        If m_CNOut.State = adStateOpen Then m_CNOut.Close
    End If
    
    Set m_CNOut = Nothing      'kill connection
    
    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.Kill"

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Sub AfterClose()

End Sub
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterConnect()
           
    Call frmShip.ToggleLookup(False)
    frmShip.f70.ListIndex = 0
    frmShip.f72.ListIndex = 0
    
End Sub


'---------------------------------------------------------------------------------------
' Procedure : BeforeClose()
' DateTime  : 7/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed before
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Function BeforeClose() As Boolean

    BeforeClose = True

End Function
'

' 2012-01-19, JFW, New for UCS.
Public Function BeforeGotFocus(f As Form, c As Control) As Boolean
    On Error GoTo Test
    Exit Function
Test:
    DebugPrint "BeforeGotFocus, " & Err.Description
    
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShip()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShip(Optional TransString As String = "") As Boolean
    
    If TransString <> "" Then
        TransactionStripTag TransString, "583"
        TransactionBuilder TransString, "583", g_str1670
        TransString = Replace(TransString, "99,""""", "")
        TransactionBuilder TransString, 99, ""
    End If
    
    BeforeShip = True

'    If frmShip.f25 = "" Then
'        MsgBox "Reference is mandatory.", vbApplicationModal + vbSystemModal
'        frmShip.SSTab1.Tab = 0
'        frmShip.f25.SetFocus
'        BeforeShip = False
'    End If
    
'    If frmShip.f38 = "" Then
'        MsgBox "Department is mandatory.", vbApplicationModal + vbSystemModal
'        frmShip.SSTab1.Tab = 0
'        frmShip.f38.SetFocus
'        BeforeShip = False
'    End If
    
'    If Left(frmShip.f25, Len(IIf(frmShip.f38.Visible, frmShip.f38, frmShip.cboDept))) <> IIf(frmShip.f38.Visible, frmShip.f38, frmShip.cboDept) Then
'        frmShip.f25 = IIf(frmShip.f38.Visible, frmShip.f38, frmShip.cboDept) & frmShip.f25
'        g_str25 = frmShip.f25
'    End If

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShipTrans()
' DateTime  : 8/7/2008
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShipTrans(ByRef TransString As String) As Boolean
    
    Dim lngMsgBoxResult As VbMsgBoxResult
    BeforeShipTrans = True
    
End Function
'

'
Public Function ClearCommodity() As Boolean

End Function
'

'
Public Sub EditBoxLostFocus(objControl As Control)

    Select Case objControl.name
        Case "f18"
'            If Trim(objControl.Text & "") = "" Then
'                objControl.Text = "4169265201"
'            End If
    End Select
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : Initialize()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution.
'---------------------------------------------------------------------------------------
'
Public Sub Initialize(Optional f1 As Form)

    frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
    
    ' 2012-06-19, Always combo
    
    ' Call frmShip.ToggleDepartment(False)
    
    'Call frmShip.ToggleLookup(True)
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeBatch()
' DateTime  : 20070621-01 Changed BeforeBatch to return a boolean
' Purpose   : REQUIRED SUB. Called before an entire batch is processed.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatch() As Boolean

    BeforeBatch = True

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatchShip()
' DateTime  : 20070822-02 Modified BeforeBatchShip to return a Boolean.
' Purpose   : REQUIRED SUB. Called just before a batch transaction is sent to the server.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatchShip() As Boolean

    BeforeBatchShip = True

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrLookup()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboCustID, cboContact, or cboCompany loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrLookup()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerify()
' DateTime  : 5/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             Address Verification. Three possible status codes are passed. See comments
'             below.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerify(ByVal intStatusCode As Integer)

    Select Case intStatusCode
        'Address is verfified
        Case 1

        'Soft error
        Case 2

        'Hard error
        Case 3

    End Select

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerifyUpdate()
' DateTime  : 9/13/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an address has been updated on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerifyUpdate()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterBatch()
' DateTime  : 4/6/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a batch shipment has been completed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatch()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterBatchShip()
' DateTime  : 10/28/2005
' Purpose   : REQUIRED SUB. Called just after a batch transaction has been processed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatchShip()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterDeptLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterDeptLostFocus()

    g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    
End Sub
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterDisconnect()

    On Error Resume Next
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterLoadServices()
' DateTime  : 5/17/2011
' Purpose   : Remove or add custom services.
' 2011-05-17, JFW, New for Scapa
'---------------------------------------------------------------------------------------
'
Public Sub AfterLoadServices(c1 As ComboBox)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterLocationChange()
' DateTime  : 3/06/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             the shipping Location has been changed on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLocationChange()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLostFocus(c1 As Control)

    If c1.name = "f38" Then
        'g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    End If
    If c1.name = "f1273" Then
        'g_clsReg.SetRegistryValue "Carry_f1273", Left(frmShip.f1273.Text, 2), REG_SZ
    End If

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterRateQuote()
' DateTime  : 20071106-01
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a rate quote.
'---------------------------------------------------------------------------------------
'
Public Sub AfterRateQuote()

End Sub
'

' 2012-01-19, JFW, New for UCS.
Public Function AfterScreenChange(f As Form) As Boolean

End Function
'


#End If

